/*
 * Perform base conversions.
 * Copyright(C)1994 Scan Retail (RDS) Inc.
 *
 * Author  :  Russ Beinder
 * Language:  OPL/S3
 * Created :  94.07.12
 *
 * Licence :  This code is provided free of charge for non-commercial use.
 *
 * This code will allow conversions between decimal, octal, hexidecimal,
 *  and binary. Resolution of up to 32 bits is possible. This code will
 *  run on a Series 3 or 3a.
 */

proc numCnvt:

   local v$(33), v
   local h$(20)
   local d$(20)
   local b$(40)
   local o$(32)
   local k%, i%

   do
      dINIT "Base Conversion"
      dTEXT "Prefix list:", " "
      dTEXT "Hex", "$ or &", 0
      dTEXT "Octal", "0", 0
      dTEXT "Binary", "%", 0
      dTEXT "Decimal", "(none)", 0
      dEDIT v$, "Value to convert:"
      k% = DIALOG

      if ( k% <> 0 or v$ = "" )

         v$ = upper$( v$ )
         if ( left$( v$, 1 ) = "$" or left$( v$, 1 ) = "&" )
            v = hex2dec:( v$ )

         elseif ( left$( v$, 1 ) = "%" )
            v = bas2dec:( v$, 2.0 )

         elseif ( left$( v$, 1 ) = "0" )
            v = bas2dec:( v$, 8.0 )

         else
            v = val( v$ )
         endif

         if ( v > 4294967295 )
            dINIT "Error"
            dTEXT "", "Conversion requires more than 32 bits."
            dTEXT "", " "
         else
         h$ = dec2bas$:( v, 16.0 )
         d$ = fix$( v, 0, 10 )
         o$ = right$( rept$( "0", 32 ) + dec2bas$:( v, 2.0 ), 32 )
         i% = 1
         b$ = left$( o$, 4 )
         while ( i% < 8 )
            b$ = b$ + " " + mid$( o$, 4 * i% + 1, 4 )
            i% = i% + 1
         endwh
         o$ = dec2bas$:( v, 8.0 )

         dINIT "Converted Values"
         dTEXT "", d$ + "  $" + h$ + "  0" + o$, 2
         dTEXT "", "%" + b$, 2

         endif

         dTEXT "", "More conversions?", 2
         dBUTTONS "Yes", 13, "No", -27
         k% = DIALOG
      endif

   until ( k% = 27 or k% = 0 )
endp





/*
 * Purpose:
 *          Convert a hexidecimal number to decimal.
 */
proc hex2dec:( s$ )

   local i%, j%, n

   i% = len( s$ )      rem The first character is not a digit
   while ( i% > 1 )
      n = n + ( loc( "0123456789ABCDEF", mid$( s$, i%, 1 )) - 1 ) * 16.0**j%

      i% = i% - 1
      j% = j% + 1
   endwh

   return intf( n + .5 )
endp




/*
 * Purpose:
 *          Convert a given base number to decimal.
 */
proc bas2dec:( s$, b )

   local i%, j%, n

   i% = len( s$ )      rem The first character is not a digit
   while ( i% > 1 )
      n = n + ( loc( left$("0123456789ABCDEF",b), mid$( s$, i%, 1 )) - 1 ) * b**j%

      i% = i% - 1
      j% = j% + 1
   endwh

   return intf( n + .5 )
endp









/*
 * Purpose:
 *          Convert the given decimal number to the given base 2 - 16.
 */
proc dec2bas$:( d, b )

   local n
   local o$(32)         rem accomodate a 32 bit number

   n = d
   while ( n > 0 )
      o$ = mid$( "0123456789ABCDEF", mod:( n, b )+1, 1 ) + o$
      n = intf( n / b )
   endwh

   return o$
endp









/*
 * Purpose:
 *          Compute the j modulus of the given number i.
 */
proc mod:( i, j )

   local d

   d = intf( i / j )
   return i - j * d
endp